home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / modula2 / hk_lib / def_mod / xstrings.mod < prev   
Encoding:
Modula Implementation  |  1994-09-22  |  35.9 KB  |  1,030 lines
  1. IMPLEMENTATION MODULE  XStrings;
  2.  
  3. (*****************************************************************************)
  4. (* August '89  Beginn                                                        *)
  5. (* 21-Sep-89 , hk                                                            *)
  6. (*         Erste Version                                                     *)
  7. (* 21-Okt-89 , hk                                                            *)
  8. (*         Aufspaltung in zwei Module (-> "Strings" )                        *)
  9. (*         Aenderungen hier: Bis auf "TrimXXX", "CompareNoCase" ist alles neu*)
  10. (* 05-Dez-89                                                                 *)
  11. (*         "FillString","ConvertStr","EqualConvStr","CompareNoCase",         *)
  12. (*         "TrimRight" in Assembler                                          *)
  13. (*****************************************************************************)
  14.  
  15.  
  16. FROM  SYSTEM   IMPORT (* PROC *)  VAL, INLINE;
  17.  
  18. FROM  Chars    IMPORT (* TYPE *)  CharConvert, CharClassTest;
  19. FROM  Strings  IMPORT (* TYPE *)  CompareResult,
  20.                       (* PROC *)  Length;
  21.  
  22. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  23.  
  24. CONST  EOS = 0C;   (* End Of String -- dynamisches Stringende *)
  25.  
  26. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  27.  
  28.   PROCEDURE  FillStr ((* EIN/ -- *)     fuellung : CHAR;
  29.                       (* EIN/ -- *)     anzahl   : CARDINAL;
  30.                       (* -- /AUS *) VAR string   : ARRAY OF CHAR );
  31. (*T*)
  32. (*   VAR  Index : CARDINAL; *)
  33.  
  34.      BEGIN
  35. (*     IF  ( anzahl = 0 )  OR  ( anzahl > VAL( CARDINAL, HIGH( string )))  THEN
  36.           anzahl := HIGH( string );
  37.        ELSE
  38.           string[ anzahl ] := EOS;
  39.           DEC( anzahl );
  40.           (* HIGH(string) koennte auch Null sein,
  41.            * deswegen nur hier verringern und nicht
  42.            * in der FOR-Schleife bis <anzahl> - 1
  43.            *)
  44.        END;
  45.  
  46.        FOR  Index := 0  TO  anzahl  DO
  47.           string[ Index ] := fuellung;
  48.        END;
  49.  
  50.     +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  51.  
  52.        string   EQU  12
  53.        HIGH     EQU  string + 4
  54.        anzahl   EQU  HIGH + 2
  55.        fuellung EQU  anzahl + 2
  56.  
  57.        FillStr:
  58.          move.b  fuellung(a6), d1
  59.          movea.l string(a6), a0
  60.          move.w  anzahl(a6), d0
  61.          subq.w  #1, d0           ; falls <anzahl> = 0 -> anzahl = MAX(CARD)
  62.          cmp.w   HIGH(a6), d0     ; IF  anzahl > HIGH( string )  THEN
  63.          blo.s   term             ;
  64.          move.w  HIGH(a6), d0     ;    anzahl := HIGH( string );
  65.          bra.s   fillp            ; ELSE
  66.        term:
  67.          clr.b   1(a0,d0.w)       ;    string[anzahl] := EOS;
  68.        fillp:                     ; END;
  69.          move.b  d1, (a0)+
  70.          dbra    d0, fillp
  71. *)
  72.        INLINE( 122EH,0014H,206EH,000CH,302EH,0012H,5340H,0B06EH,0010H );
  73.        INLINE( 6506H,302EH,0010H,6004H,4230H,0001H,10C1H,51C8H,0FFFCH );
  74.  
  75.      END  FillStr;
  76.  
  77. (* ------------------------------------------------------------------------- *)
  78.  
  79.   PROCEDURE  ConvertStr ((* EIN/ -- *)     quelle  : ARRAY OF CHAR;
  80.                          (* EIN/ -- *)     convert : CharConvert;
  81.                          (* -- /AUS *) VAR ziel    : ARRAY OF CHAR;
  82.                          (* -- /AUS *) VAR vollst  : BOOLEAN       );
  83. (*T*)
  84. (*   VAR  Index,
  85.           MaxIndex : CARDINAL; *)
  86.  
  87.      BEGIN
  88. (*     IF  HIGH( quelle )  >  HIGH( ziel )  THEN
  89.           MaxIndex := HIGH( ziel );
  90.        ELSE
  91.           MaxIndex := HIGH( quelle );
  92.        END;
  93.  
  94.        Index := 0;
  95.        WHILE ( Index <= MaxIndex ) & ( quelle[ Index ] # EOS )  DO
  96.  
  97.           (* (0<=Index<=HIGH(quelle)) & (0<=Index<=HIGH(ziel)) &
  98.            * ((0<=i<Index) => (ziel[i]=convert(quelle[i])))    &
  99.            * ((0<=i<=Index) => (quelle[i] # EOS))
  100.            *)
  101.           ziel[ Index ] := convert( quelle[ Index ] );
  102.           INC( Index );
  103.        END;
  104.  
  105.        (* ((Index=HIGH(ziel)+1) OR (Index=HIGH(quelle)+1) OR
  106.         *  (quelle[Index]=EOS)                                ) &
  107.         * ((0<=i<Index) => (ziel[i]=convert(quelle[i]) # EOS ))
  108.         *)
  109.  
  110.        IF  ( Index > VAL( CARDINAL, HIGH( quelle )))  OR
  111.            ( quelle[ Index ] = EOS                 )
  112.        THEN
  113.           vollst := TRUE;
  114.           IF  Index <= VAL( CARDINAL, HIGH( ziel ))  THEN
  115.              ziel[ Index ] := EOS;
  116.           END;
  117.        ELSE
  118.           vollst := FALSE;
  119.        END;
  120.  
  121.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  122.  
  123.        vollst  EQU  12
  124.        ziel    EQU  vollst + 4    ; VAR-Parameter !
  125.        ZHIGH   EQU  ziel + 4
  126.        convert EQU  ZHIGH + 2     ; Adresse der Prozedur
  127.        quelle  EQU  convert + 4
  128.        QHIGH   EQU  quelle + 4
  129.  
  130.        ConvertStr:
  131.          movea.l quelle(a6), a0 ; a0 -> quelle, lokale Variable
  132.          movea.l ziel(a6), a1   ; a1 -> ziel
  133.          move.w  QHIGH(a6), d0  ; d0 := MIN( HIGH(quelle), HIGH(ziel) )
  134.          cmp.w   ZHIGH(a6), d0  ;
  135.          bls.s   asgnlp         ;
  136.          move.w  ZHIGH(a6), d0  ;
  137.        asgnlp:
  138.          move.b  (a0)+, d5      ; ein Zeichen...
  139.          movem.l d0/a0/a1, -(a7); benoetigte Register retten...
  140.          subq.l  #2, a7         ; Platz fuer Funktionswert ( Stackpointer
  141.                                 ; immer wortweise veraendern )
  142.          move.b  d5, -(a7)      ; zu wandelndes Zeichen ( hier auch Wort! )
  143.          movea.l convert(a6), a0
  144.          jsr     (a0)           ; ...wandeln...
  145.          move.b  (a7)+, d5      ; ...merken... ( Stack wird um 2(!) erhoeht )
  146.          movem.l (a7)+, d0/a0/a1; ...und zurueckschreiben
  147.          move.b  d5, (a1)+      ; ...und kopieren
  148.          dbeq    d0, asgnlp     ; B: Quelle noch nicht vollstaendig kopiert
  149.  
  150.          beq.s   voll
  151.          moveq   #0, d1         ; Default: Kopie nicht vollstaendig
  152.          move.l  a0, d2         ; wird oefter gebraucht
  153.          movea.l quelle(a6), a2 ; d2 := Anzahl kopierter Zeichen( = Index )
  154.          sub.l   a2, d2         ;
  155.          cmp.w   QHIGH(a6), d2  ; Index > HIGH(quelle) ?
  156.          bhi.s   tsteos         ; B: ja, Quelle vollstaendig kopiert
  157.          tst.b   (a0)           ; hinter dem letzten kopierten Zeichen  EOS  ?
  158.          bne.s   ende           ; B: nein, dann Quelle nicht vollst. kopiert
  159.        tsteos:
  160.          cmp.w   ZHIGH(a6), d2  ; Ist im Zielstring noch Platz fuer Nullbyte ?
  161.          bhi.s   voll           ; B: nein, Ziel voll
  162.          clr.b   (a1)           ;
  163.        voll:
  164.          moveq   #1, d1
  165.        ende:
  166.          movea.l vollst(a6), a0 ; vollst VAR-Parameter !
  167.          move.b  d1, (a0)       ; vollst setzen
  168. *)
  169.        INLINE( 206EH,001AH,226EH,0010H,302EH,001EH,0B06EH,0014H,6304H );
  170.        INLINE( 302EH,0014H,1A18H,48E7H,80C0H,558FH,1F05H,206EH,0016H );
  171.        INLINE( 4E90H,1A1FH,4CDFH,0301H,12C5H,57C8H,0FFE6H,671CH,7200H );
  172.        INLINE( 2408H,246EH,001AH,948AH,0B46EH,001EH,6204H,4A10H,660AH );
  173.        INLINE( 0B46EH,0014H,6202H,4211H,7201H,206EH,000CH,1081H );
  174.  
  175.      END  ConvertStr;
  176.  
  177. (* ------------------------------------------------------------------------- *)
  178.  
  179.   PROCEDURE  EqualConvStr ((* EIN/ -- *) string1,
  180.                            (* EIN/ -- *) string2 : ARRAY OF CHAR;
  181.                            (* EIN/ -- *) convert : CharConvert    ): BOOLEAN;
  182. (*T*)
  183. (*   VAR  Index,
  184.           MaxIndex : CARDINAL; *)
  185.  
  186.      BEGIN
  187. (*     Index := 0;
  188.  
  189.        IF      HIGH( string1 )  <  HIGH( string2 )  THEN
  190.            MaxIndex := HIGH( string1 );
  191.        ELSE
  192.            MaxIndex := HIGH( string2 );
  193.        END;
  194.  
  195.       (* MaxIndex = MIN( HIGH( string1 ), HIGH( string2 )) *)
  196.  
  197.        LOOP
  198.          IF    Index > MaxIndex  THEN
  199.             EXIT;
  200.          ELSIF  string1[ Index ] # string2[ Index ] THEN
  201.  
  202.            (* Erst mal testen, ob die beiden Zeichen nicht schon
  203.             * ohne Konvertierung gleich sind, um moeglicherweise
  204.             * den aufwendigen Funktionsaufruf einzusparen.
  205.             *)
  206.            IF convert( string1[ Index ] ) # convert( string2[ Index ] )  THEN
  207.               RETURN( FALSE );
  208.            ELSIF string1[ Index ] = EOS  THEN
  209.               RETURN( TRUE );
  210.            END; (* IF convert(.. *)
  211.  
  212.          ELSIF string1[ Index ] = EOS  THEN
  213.             RETURN( TRUE );  (* Wenn string1 = 0C, dann auch string2 *)
  214.          END; (* IF *)
  215.  
  216.          INC( Index );
  217.        END; (* LOOP *)
  218.  
  219.        (* Index = MaxIndex + 1 *)
  220.  
  221.        (*
  222.         * Strings sind auch gleich, falls der eine das ARRAY fuellt
  223.         * und der andere hinter dem letzten verglichenen Zeichen
  224.         * mit "EOS" abgeschlossen ist
  225.         *)
  226.        RETURN( NOT (( HIGH( string1 ) < HIGH( string2 )) &
  227.                     ( string2[ Index ] # EOS           )   ) OR
  228.                    (( HIGH( string1 ) > HIGH( string2 )) &
  229.                     ( string1[ Index ] # EOS           )   )    );
  230.  
  231.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  232.  
  233.        convert  EQU  12
  234.        string2  EQU  convert + 4
  235.        HIGH2    EQU  string2 + 4
  236.        string1  EQU  HIGH2 + 2
  237.        HIGH1    EQU  string1 + 4
  238.        RETURN   EQU  HIGH1 + 2
  239.  
  240.        EqualConvStr:
  241.          movea.l string1(a6), a0 ; a0 -> string1
  242.          movea.l string2(a6), a1 ; a1 -> string2
  243.          move.w  HIGH1(a6), d0   ; d0 := MIN( HIGH(string1),HIGH(string2))
  244.          cmp.w   HIGH2(a6), d0   ;
  245.          bls.s   eqcnvlp         ;
  246.          move.w  HIGH2(a6), d0   ;
  247.        eqcnvlp:
  248.          move.b  (a0)+, d1       ; Ist naechstes string1-Zeichen = EOS ?
  249.          beq.s   tst2eos         ; B: ja, Schleife zuende und string2-EOS-Test
  250.          move.b  (a1)+, d3       ; sonst mit naechstem string2-Zeichen vergl.
  251.          cmp.b   d1, d3
  252.          beq.s   eqcnvcnt        ; B: sind gleich, naechstes Zeichen
  253.          movem.l a0/a1/d0, -(a7) ; benutzte Register retten+++
  254.          move.b  d3, -(a7)       ; zweites Zeichen retten..
  255.          subq.l  #2, a7          ; Platz fuer Funktionswert ( Stackpointer
  256.                                  ; immer wortweise veraendern )
  257.          move.b  d1, -(a7)       ; zu wandelndes Zeichen ( hier auch Wort! )
  258.          movea.l convert(a6), a0
  259.          jsr     (a0)            ; ...wandeln...
  260.          move.b  (a7)+, d1       ;
  261.          move.b  (a7)+, d3       ;..zurueck
  262.          move.b  d1, -(a7)       ; derweil erstes Zeichen retten..
  263.          subq.l  #2, a7          ; Platz fuer Funktionswert ( Stackpointer
  264.                                  ; immer wortweise veraendern )
  265.          move.b  d3, -(a7)       ; zu wandelndes Zeichen ( hier auch ! )
  266.          movea.l convert(a6), a0
  267.          jsr     (a0)            ; ...wandeln...
  268.          move.b  (a7)+, d3       ;
  269.          move.b  (a7)+, d1       ;.. und zurueck
  270.          cmp.b   d1, d3          ; nochmal gewandelt vergleichen
  271.          movem.l (a7)+, a0/a1/d0 ;+++ Befehl aendert nicht die Flags !
  272.        eqcnvcnt:
  273.          dbne    d0, eqcnvlp     ; B: sind noch gleich und nicht zuende
  274.          bne.s   false           ; B: unterschiedliches Zeichen entdeckt
  275.          move.w  HIGH1(a6), d0   ; string1-Feld groesser als string2-Feld ?
  276.          cmp.w   HIGH2(a6), d0   ;
  277.          beq.s   true            ; B: sind gleich, also Strings gleich
  278.          blo.s   tst2eos         ; B: nein, kleiner, also string2-Ende-Test
  279.          tst.b   (a0)            ; sonst testen, ob auch string1 zuende
  280.          beq.s   true            ; B: ja, Strings gleich
  281.          bra.s   false           ; B: string1 nicht zuende -> unterschiedl.
  282.        tst2eos:
  283.          tst.b   (a1)            ; string2 zuende ?
  284.          beq.s   true            ; B: ja, beide gleichlang
  285.        false:
  286.          moveq   #0, d2
  287.          bra.s   ende
  288.        true:
  289.          moveq   #1, d2
  290.        ende:
  291.          move.b  d2, RETURN(a6)
  292. *)
  293.        INLINE( 206EH,0016H,226EH,0010H,302EH,001AH,0B06EH,0014H,6304H );
  294.        INLINE( 302EH,0014H,1218H,6748H,1619H,0B601H,672AH,48E7H,80C0H );
  295.        INLINE( 1F03H,558FH,1F01H,206EH,000CH,4E90H,121FH,161FH,1F01H );
  296.        INLINE( 558FH,1F03H,206EH,000CH,4E90H,161FH,121FH,0B601H,4CDFH );
  297.        INLINE( 0301H,56C8H,0FFCAH,6616H,302EH,001AH,0B06EH,0014H,6710H );
  298.        INLINE( 6506H,4A10H,670AH,6004H,4A11H,6704H,7400H,6002H,7401H );
  299.        INLINE( 1D42H,001CH );
  300.  
  301.      END  EqualConvStr;
  302.  
  303. (* ------------------------------------------------------------------------- *)
  304.  
  305.   PROCEDURE CompareCAPStr ((* EIN/ -- *) string1,
  306.                            (* EIN/ -- *) string2:ARRAY OF CHAR ):CompareResult;
  307. (*T*)
  308. (*   VAR  Index,
  309.           MaxIndex : CARDINAL; *)
  310.  
  311.      BEGIN
  312. (*     Index := 0;
  313.  
  314.        IF      HIGH( string1 )  <  HIGH( string2 )  THEN
  315.            MaxIndex := HIGH( string1 );
  316.        ELSE
  317.            MaxIndex := HIGH( string2 );
  318.        END;
  319.  
  320.       (* MaxIndex = MIN( HIGH( string1 ), HIGH( string2 )) *)
  321.  
  322.        LOOP
  323.          IF    Index > MaxIndex  THEN
  324.             EXIT;
  325.          ELSIF  CAP( string1[ Index ] )  #  CAP( string2[ Index ] )  THEN
  326.  
  327.             (* Ergebnis aus dem ersten unterschiedlichen Zeichen bilden
  328.              *)
  329.             IF  CAP( string1[ Index ] )  <  CAP( string2[ Index ] )  THEN
  330.                RETURN( less );
  331.             ELSE
  332.                RETURN( greater );
  333.             END;
  334.  
  335.          (* string1[ Index ] = string2[ Index ] *)
  336.          ELSIF string1[ Index ] = EOS  THEN
  337.             RETURN( equal );
  338.          END; (* IF *)
  339.  
  340.          INC( Index );
  341.        END; (* LOOP *)
  342.  
  343.        (* Index = maxIndex + 1 *)
  344.  
  345.        IF      HIGH( string1 ) < HIGH( string2 )  THEN
  346.           (* Index <= HIGH( string2 ) *)
  347.  
  348.           IF   string2[ Index ] = EOS  THEN
  349.              RETURN( equal );
  350.           ELSE
  351.              RETURN( less );
  352.           END; (* IF string2[ Index ] *)
  353.  
  354.        ELSIF   HIGH( string1 ) > HIGH( string2 )  THEN
  355.           (* Index <= HIGH( string1 ) *)
  356.  
  357.           IF   string1[ Index ] = EOS  THEN
  358.              RETURN( equal );
  359.           ELSE
  360.              RETURN( greater );
  361.           END; (* IF string1[ Index ] *)
  362.  
  363.        ELSE (* HIGH( string1 ) = HIGH( string2 ) *)
  364.           RETURN( equal );
  365.        END; (* IF HIGH( string1 ) < HIGH( string2 ) *);
  366.  
  367.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  368.  
  369.         string2  EQU  12
  370.         HIGH2    EQU  string2 + 4
  371.         string1  EQU  HIGH2 + 2
  372.         HIGH1    EQU  string1 + 4
  373.         RETURN   EQU  HIGH1 + 2
  374.  
  375.         less     EQU  0
  376.         equal    EQU  1
  377.         greater  EQU  2
  378.  
  379.         CompareCAPStr:
  380.           moveq   #equal, d2      ; Default: Strings gleich
  381.           movea.l string1(a6), a0 ; a0 -> string1
  382.           movea.l string2(a6), a1 ; a1 -> string2
  383.           move.w  HIGH1(a6), d0   ; d0 := MIN(HIGH(string1),HIGH(string2))
  384.           cmp.w   HIGH2(a6), d0   ;
  385.           bls.s   eqlp            ;
  386.           move.w  HIGH2(a6), d0   ;
  387.         eqlp:
  388.           move.b  (a0)+, d1       ; naechstes Zeichen von <string1>
  389.           beq.s   tstless         ; B: <string1> zuende
  390.           move.b  (a1)+, d3       ; mit naechstem von <string2>
  391.           cmp.b   d1, d3          ; vergleichen
  392.           beq.s   cmpnclpcnt      ; B: sind gleich, naechstes Zeichen
  393.           move.b  d1, d4
  394.           move.b  d3, d5
  395.           andi.b  #%11011111, d4  ; mal probieren ob's an Gross/Klein-
  396.           andi.b  #%11011111, d5  ; schreibung liegt
  397.           cmp.b   d5, d4          ;
  398.           bne.s   cmp             ; B: sind unterschiedlich
  399.           cmpi.b  #'A', d4        ; Konvertierung klein -> gross hat natuer-
  400.                                   ; lich nur Sinn, wenn es sich um Buchstaben
  401.                                   ; handelt
  402.           blo.s   cmp             ; B: war kein Buchstabe, also ungleich
  403.           cmpi.b  #'Z', d4
  404.           bls.s   cmpnclpcnt      ; B: Buchstabe -> gleich
  405.         cmp:
  406.           cmp.b   d3, d1          ; Welcher ist also groesser ?
  407.           bhi.s   gr              ; B: der von <string1>
  408.           bra.s   ls              ; sonst der von <string2>
  409.         cmpnclpcnt:
  410.           dbra    d0, eqlp        ; B: bisher gleich, noch nicht alle durch
  411.           move.w  HIGH1(a6), d0
  412.           cmp.w   HIGH2(a6), d0
  413.           beq.s   ende
  414.           blo.s   tstless
  415.           tst.b   (a0)
  416.           beq.s   ende
  417.         gr:
  418.           moveq   #greater, d2
  419.           bra.s   ende
  420.         tstless:
  421.           tst.b   (a1)
  422.           beq.s   ende
  423.         ls:
  424.           moveq   #less, d2
  425.         ende:
  426.           move.b  d2, RETURN(a6)
  427. *)
  428.         INLINE( 7401H,206EH,0012H,226EH,000CH,302EH,0016H,0B06EH,0010H );
  429.         INLINE( 6304H,302EH,0010H,1218H,6740H,1619H,0B601H,6722H,1801H );
  430.         INLINE( 1A03H,0204H,00DFH,0205H,00DFH,0B805H,660CH,0C04H,0041H );
  431.         INLINE( 6506H,0C04H,005AH,6306H,0B203H,6216H,601CH,51C8H,0FFD2H );
  432.         INLINE( 302EH,0016H,0B06EH,0010H,6710H,6508H,4A10H,670AH,7402H );
  433.         INLINE( 6006H,4A11H,6702H,7400H,1D42H,0018H );
  434.  
  435.      END  CompareCAPStr;
  436.  
  437. (* ------------------------------------------------------------------------- *)
  438.  
  439.   PROCEDURE  LeftPosConvStr ((* EIN/ -- *) muster  : ARRAY OF CHAR;
  440.                              (* EIN/ -- *) start   : CARDINAL;
  441.                              (* EIN/ -- *) string  : ARRAY OF CHAR;
  442.                              (* EIN/ -- *) convert : CharConvert;
  443.                              (* EIN/ -- *) links   : BOOLEAN       ): CARDINAL;
  444. (*T*)
  445.      VAR  Versuche,
  446.           MusterLaenge,
  447.           StringLaenge,
  448.           MusterIndex  : CARDINAL;
  449.  
  450.      BEGIN
  451.        MusterLaenge := Length( muster );
  452.        StringLaenge := Length( string );
  453.  
  454.        IF  start > 0  THEN  DEC( start ); END;
  455.  
  456.        IF   ( MusterLaenge = 0                        )  OR
  457.             ( MusterLaenge > ( MAX(CARDINAL) - start ))  OR
  458.             ((  start + MusterLaenge ) > StringLaenge )
  459.        THEN
  460.           (* Bei arithmetischem Ueberlauf von <start> + <MusterLaenge>
  461.            * kann das Muster auch nicht in <string> auftreten
  462.            *)
  463.           RETURN( 0 );
  464.        ELSE
  465.           Versuche := StringLaenge - MusterLaenge - start;
  466.  
  467.           (* Sooft muss das Muster maximal - um eine Position nach rechts
  468.            * versetzt - erneut mit dem String verglichen werden. Wenn dann noch
  469.            * keine Uebereinstimmung festgestellt wurde, ist <muster> nicht
  470.            * enthalten, da der Reststring kuerzer als <muster> ist.
  471.            *)
  472.        END;
  473.  
  474.        LOOP
  475.          MusterIndex := 0;
  476.  
  477.          (* Bis zum Musterende oder dem ersten unterschiedlichen Zeichen
  478.           * suchen
  479.           *)
  480.          WHILE  ( MusterIndex < MusterLaenge        )  &
  481.                 (   convert( string[ start ])
  482.                   = convert( muster[ MusterIndex ]) )
  483.          DO
  484.             INC( start );
  485.             INC( MusterIndex );
  486.          END; (* WHILE *)
  487.  
  488.          DEC( start, MusterIndex );
  489.  
  490.          IF    MusterIndex = MusterLaenge  THEN
  491.  
  492.          (* Bis zum Ende von <muster> stimmt alles ueberein,
  493.           * also gefunden
  494.           *)
  495.             IF   links  THEN
  496.                RETURN( start + 1 );
  497.             ELSE
  498.                RETURN( StringLaenge - start );
  499.             END;
  500.          END; (* IF  MusterIndex *)
  501.  
  502.          IF  Versuche = 0  THEN  RETURN( 0 ); END;
  503.  
  504.          INC( start );   (* eins weiter rechts versuchen *)
  505.          DEC( Versuche );
  506.  
  507.        END; (* LOOP *)
  508.  
  509.      END  LeftPosConvStr;
  510.  
  511. (* ------------------------------------------------------------------------- *)
  512.  
  513.   PROCEDURE RightPosConvStr ((* EIN/ -- *) muster  : ARRAY OF CHAR;
  514.                              (* EIN/ -- *) start   : CARDINAL;
  515.                              (* EIN/ -- *) string  : ARRAY OF CHAR;
  516.                              (* EIN/ -- *) convert : CharConvert;
  517.                              (* EIN/ -- *) links   : BOOLEAN       ): CARDINAL;
  518. (*T*)
  519.      VAR  MusterLaenge,
  520.           StringLaenge,
  521.           MusterIndex  : CARDINAL;
  522.  
  523.      BEGIN
  524.        MusterLaenge := Length( muster );
  525.        StringLaenge := Length( string );
  526.  
  527.        IF  ( MusterLaenge = 0 )  OR  ( StringLaenge = 0 )  OR
  528.            ( MusterLaenge > StringLaenge )
  529.        THEN
  530.           RETURN( 0 );
  531.        END;
  532.  
  533.        IF  ( start = 0 )  OR  ( start > StringLaenge - MusterLaenge )  THEN
  534.  
  535.           (* Soweit hinten wie sinnvoll mit der Suche beginnen, d.h. es
  536.            * muessen mindestens Length( string ) Zeichen mit dem String
  537.            * verglichen werden koennen.
  538.            *)
  539.           start := StringLaenge - MusterLaenge;
  540.        ELSE
  541.           DEC( start );
  542.        END;
  543.  
  544.        LOOP
  545.          MusterIndex := 0;
  546.  
  547.          WHILE ( MusterIndex < MusterLaenge                                 ) &
  548.                ( convert( string[ start ]) = convert( muster[ MusterIndex ]))
  549.          DO
  550.             INC( start );
  551.             INC( MusterIndex );
  552.          END; (* WHILE *)
  553.  
  554.          DEC( start, MusterIndex );
  555.  
  556.          IF    MusterIndex = MusterLaenge  THEN  (* gefunden *)
  557.             IF   links  THEN
  558.                RETURN( start + 1 );
  559.             ELSE
  560.                RETURN( StringLaenge - start );
  561.             END;
  562.          END; (* IF  MusterIndex *)
  563.  
  564.          IF  start = 0  THEN  RETURN( 0 ); END;
  565.  
  566.          DEC( start );
  567.        END; (* LOOP *)
  568.  
  569.      END  RightPosConvStr;
  570.  
  571. (* ------------------------------------------------------------------------- *)
  572.  
  573.   PROCEDURE  LeftPosInSet ((* EIN/ -- *) charSet : ARRAY OF CHAR;
  574.                            (* EIN/ -- *) start   : CARDINAL;
  575.                            (* EIN/ -- *) string  : ARRAY OF CHAR;
  576.                            (* EIN/ -- *) links   : BOOLEAN       ): CARDINAL;
  577. (*T*)
  578.      VAR  SetIndex,
  579.           SetLaenge,
  580.           StringLaenge : CARDINAL;
  581.           Zeichen      : CHAR;
  582.  
  583.      BEGIN
  584.        StringLaenge := Length( string );
  585.        SetLaenge    := Length( charSet );
  586.  
  587.        IF  start > 0  THEN
  588.           DEC( start );
  589.        END;
  590.        (* #start# = start *)
  591.  
  592.        LOOP
  593.          IF  start >= StringLaenge  THEN  RETURN( 0 ); END;
  594.  
  595.          (* (#start#<=start<StringLaenge                                    ) &
  596.           * (#start#<=i<start) & ((0<=j<SetLaenge)=>(string[i] # charSet[j]))
  597.           *)
  598.          SetIndex := 0;
  599.          Zeichen := string[ start ];
  600.  
  601.          WHILE  ( SetIndex < SetLaenge          ) &
  602.                 ( charSet[ SetIndex ] # Zeichen )
  603.          DO
  604.             (* (0<=SetIndex<SetLaenge                   )  &
  605.              * ((0<=i<=SetIndex)=>(charSet[i] # Zeichen))
  606.              *)
  607.             INC( SetIndex );
  608.          END; (* WHILE *)
  609.          (* ((SetIndex=SetLaenge) OR (charSet[SetIndex] = Zeichen)) &
  610.           * ((0<=i<SetIndex) => (charSet[i] # Zeichen             )
  611.           *)
  612.  
  613.          IF    SetIndex < SetLaenge  THEN
  614.            (* Noch nicht die gesamte Menge durchsucht, also gefunden *)
  615.  
  616.             IF   links  THEN
  617.                RETURN( start + 1 );
  618.             ELSE
  619.                RETURN( StringLaenge - start );
  620.             END;
  621.          END; (* IF  SetIndex *)
  622.  
  623.          INC( start );
  624.  
  625.        END; (* LOOP *)
  626.  
  627.      END  LeftPosInSet;
  628.  
  629. (* ------------------------------------------------------------------------- *)
  630.  
  631.   PROCEDURE  RightPosInSet ((* EIN/ -- *) charSet : ARRAY OF CHAR;
  632.                             (* EIN/ -- *) start   : CARDINAL;
  633.                             (* EIN/ -- *) string  : ARRAY OF CHAR;
  634.                             (* EIN/ -- *) links   : BOOLEAN       ): CARDINAL;
  635. (*T*)
  636.      VAR  SetIndex,
  637.           SetLaenge,
  638.           StringLaenge : CARDINAL;
  639.           Zeichen      : CHAR;
  640.  
  641.      BEGIN
  642.        StringLaenge := Length( string );
  643.        SetLaenge    := Length( charSet );
  644.  
  645.        IF  StringLaenge = 0  THEN  RETURN( 0 ); END;
  646.  
  647.        IF  ( start = 0 ) OR ( start >= StringLaenge )  THEN
  648.           start := StringLaenge - 1;   (* Am Ende mit der Suche beginnen *)
  649.        ELSE
  650.           DEC( start );
  651.        END;
  652.       (* #start# = start *)
  653.  
  654.        LOOP
  655.       (* (0<=start<=#start#                                               ) &
  656.          (((start<i<=#start) & (0<=j<SetLaenge))=>(string[i] # charSet[j]))  *)
  657.  
  658.          SetIndex := 0;
  659.          Zeichen := string[ start ];
  660.  
  661.          WHILE  ( SetIndex < SetLaenge          ) &
  662.                 ( charSet[ SetIndex ] # Zeichen )
  663.          DO
  664.         (* (0<=SetIndex<SetLaenge                     ) &
  665.            ((0<=i<=SetIndex) => (charSet[i] # Zeichen))   *)
  666.  
  667.             INC( SetIndex );
  668.          END; (* WHILE *)
  669.         (* ((SetIndex=SetLaenge) OR (charSet[SetIndex] = Zeichen)) &
  670.            ((0<=i<SetIndex) => (charSet[i] # Zeichen             )   *)
  671.  
  672.          IF    SetIndex < SetLaenge  THEN
  673.            (* Noch nicht die gesamte Menge durchsucht, also gefunden *)
  674.  
  675.             IF   links  THEN
  676.                RETURN( start + 1 );
  677.             ELSE
  678.                RETURN( StringLaenge - start );
  679.             END;
  680.          END; (* IF  SetIndex *)
  681.  
  682.          IF  start = 0  THEN  RETURN( 0 ); END;
  683.  
  684.          DEC( start );
  685.  
  686.        END; (* LOOP *)
  687.  
  688.      END  RightPosInSet;
  689.  
  690. (* ------------------------------------------------------------------------- *)
  691.  
  692.   PROCEDURE  LeftPosInClass ((* EIN/ -- *) inClass : CharClassTest;
  693.                              (* EIN/ -- *) start   : CARDINAL;
  694.                              (* EIN/ -- *) string  : ARRAY OF CHAR;
  695.                              (* EIN/ -- *) links   : BOOLEAN       ): CARDINAL;
  696. (*T*)
  697.      VAR  StringLaenge : CARDINAL;
  698.  
  699.      BEGIN
  700.        StringLaenge := Length( string );
  701.  
  702.        IF  start > 0  THEN  DEC( start ); END;
  703.       (* #start# = start *)
  704.  
  705.        WHILE  ( start < StringLaenge ) & ~inClass( string[ start ] )  DO
  706.       (* (#start#<=start<StringLaenge              ) &
  707.          ((#start#<=i<=start)=> ~inClass(string[i]))   *)
  708.  
  709.           INC( start );
  710.        END; (* WHILE *)
  711.       (* (start=StringLaenge) OR inClass(string[start]))  &
  712.          ((#start#<=i<start)=> ~inClass(string[i])     )    *)
  713.  
  714.        IF   start < StringLaenge  THEN
  715.          (* Noch nicht gesamter String durchsucht, also gefunden *)
  716.  
  717.           IF   links  THEN
  718.              RETURN( start + 1 );
  719.           ELSE
  720.              RETURN( StringLaenge - start );
  721.           END;
  722.        ELSE
  723.           RETURN( 0 );
  724.        END; (* IF  start *)
  725.  
  726.      END  LeftPosInClass;
  727.  
  728. (* ------------------------------------------------------------------------- *)
  729.  
  730.   PROCEDURE  RightPosInClass ((* EIN/ -- *) inClass: CharClassTest;
  731.                               (* EIN/ -- *) start  : CARDINAL;
  732.                               (* EIN/ -- *) string : ARRAY OF CHAR;
  733.                               (* EIN/ -- *) links  : BOOLEAN       ): CARDINAL;
  734. (*T*)
  735.      VAR  StringLaenge : CARDINAL;
  736.  
  737.      BEGIN
  738.        StringLaenge := Length( string );
  739.  
  740.        IF  StringLaenge = 0  THEN  RETURN( 0 ); END;
  741.  
  742.        IF  ( start = 0 ) OR ( start >= StringLaenge )  THEN
  743.  
  744.           start := StringLaenge - 1;
  745.  
  746.           (* Am Ende mit der Suche beginnen;
  747.            * 0 <=start <= MAX(INTEGER) < StringLaenge
  748.            *)
  749.        ELSE
  750.           DEC( start );
  751.        END;
  752.  
  753.        WHILE  ( VAL( INTEGER, start ) >= 0 ) & ~inClass( string[ start ] )  DO
  754.           DEC( VAL( INTEGER, start ));
  755.        END; (* WHILE *)
  756.  
  757.        IF  VAL( INTEGER, start ) >= 0  THEN
  758.  
  759.           IF   links  THEN
  760.              RETURN( start + 1 );
  761.           ELSE
  762.              RETURN( StringLaenge - start );
  763.           END;
  764.        ELSE
  765.           RETURN( 0 );
  766.        END; (* IF  VAL(  *)
  767.  
  768.      END  RightPosInClass;
  769.  
  770. (* ------------------------------------------------------------------------- *)
  771.  
  772.   PROCEDURE  LeftPosNotInSet ((* EIN/ -- *) charSet: ARRAY OF CHAR;
  773.                               (* EIN/ -- *) start  : CARDINAL;
  774.                               (* EIN/ -- *) string : ARRAY OF CHAR;
  775.                               (* EIN/ -- *) links  : BOOLEAN       ): CARDINAL;
  776. (*T*)
  777.     (* Das gleiche wie "LeftPosInSet", nur Abfrage: SetIndex = SetLaenge *)
  778.  
  779.      VAR  SetIndex,
  780.           SetLaenge,
  781.           StringLaenge : CARDINAL;
  782.           Zeichen      : CHAR;
  783.  
  784.      BEGIN
  785.        StringLaenge := Length( string );
  786.        SetLaenge    := Length( charSet );
  787.        IF  start > 0  THEN  DEC( start ); END;
  788.        LOOP
  789.          IF  start >= StringLaenge  THEN
  790.             RETURN( 0 );
  791.          END;
  792.          SetIndex := 0;
  793.          Zeichen := string[ start ];
  794.          WHILE  ( SetIndex < SetLaenge          ) &
  795.                 ( charSet[ SetIndex ] # Zeichen )
  796.          DO
  797.             INC( SetIndex );
  798.          END; (* WHILE *)
  799.          IF   SetIndex = SetLaenge  THEN   (* nicht in <charSet> gefunden *)
  800.             IF   links  THEN
  801.                RETURN( start + 1 );
  802.             ELSE
  803.                RETURN( StringLaenge - start );
  804.             END;
  805.          END;
  806.          INC( start );
  807.        END;
  808.      END  LeftPosNotInSet;
  809.  
  810. (* ------------------------------------------------------------------------- *)
  811.  
  812.   PROCEDURE RightPosNotInSet ((* EIN/ -- *) charSet: ARRAY OF CHAR;
  813.                               (* EIN/ -- *) start  : CARDINAL;
  814.                               (* EIN/ -- *) string : ARRAY OF CHAR;
  815.                               (* EIN/ -- *) links  : BOOLEAN       ): CARDINAL;
  816. (*T*)
  817.     (* Das gleiche wie "RightPosInSet", nur Abfrage: SetIndex = SetLaenge *)
  818.  
  819.      VAR  SetIndex,
  820.           SetLaenge,
  821.           StringLaenge : CARDINAL;
  822.           Zeichen      : CHAR;
  823.  
  824.      BEGIN
  825.        StringLaenge := Length( string );
  826.        SetLaenge    := Length( charSet );
  827.        IF  ( start = 0 ) OR ( start >= StringLaenge )  THEN
  828.           start := StringLaenge - 1;
  829.        ELSE
  830.           DEC( start );
  831.        END;
  832.        LOOP
  833.          SetIndex := 0;
  834.          Zeichen := string[ start ];
  835.          WHILE  ( SetIndex < SetLaenge          ) &
  836.                 ( charSet[ SetIndex ] # Zeichen )
  837.          DO
  838.             INC( SetIndex );
  839.          END;
  840.          IF    SetIndex = SetLaenge  THEN   (* nicht in <charSet> gefunden *)
  841.             IF   links  THEN
  842.                RETURN( start + 1 );
  843.             ELSE
  844.                RETURN( StringLaenge - start );
  845.             END;
  846.          END;
  847.          IF  start = 0  THEN
  848.             RETURN( 0 );
  849.          END;
  850.          DEC( start );
  851.        END;
  852.  
  853.      END  RightPosNotInSet;
  854.  
  855. (* ------------------------------------------------------------------------- *)
  856.  
  857.   PROCEDURE LeftPosNotInClass ((* EIN/ -- *) inClass: CharClassTest;
  858.                                (* EIN/ -- *) start  : CARDINAL;
  859.                                (* EIN/ -- *) string : ARRAY OF CHAR;
  860.                                (* EIN/ -- *) links  : BOOLEAN       ):CARDINAL;
  861. (*T*)
  862.      (* das gleiche wie "LeftPosInClass", nur: inClass() <-> ~inClass() *)
  863.  
  864.      VAR  StringLaenge : CARDINAL;
  865.  
  866.      BEGIN
  867.        StringLaenge := Length( string );
  868.        IF  start > 0  THEN  DEC( start ); END;
  869.        WHILE  ( start < StringLaenge ) & inClass( string[ start ] )  DO
  870.           INC( start );
  871.        END;
  872.        IF   start < StringLaenge  THEN
  873.           IF   links  THEN
  874.              RETURN( start + 1 );
  875.           ELSE
  876.              RETURN( StringLaenge - start );
  877.           END;
  878.        ELSE
  879.           RETURN( 0 );
  880.        END;
  881.      END  LeftPosNotInClass;
  882.  
  883. (* ------------------------------------------------------------------------- *)
  884.  
  885.   PROCEDURE RightPosNotInClass ((* EIN/ -- *) inClass: CharClassTest;
  886.                                 (* EIN/ -- *) start  : CARDINAL;
  887.                                 (* EIN/ -- *) string : ARRAY OF CHAR;
  888.                                 (* EIN/ -- *) links  : BOOLEAN      ):CARDINAL;
  889. (*T*)
  890.      (* das gleiche wie "RightPosInClass", nur: inClass() <-> ~inClass() *)
  891.  
  892.      VAR  StringLaenge : CARDINAL;
  893.  
  894.      BEGIN
  895.        StringLaenge := Length( string );
  896.        IF  StringLaenge = 0  THEN  RETURN( 0 ); END;
  897.        IF  ( start = 0 ) OR ( start >= StringLaenge )  THEN
  898.           start := StringLaenge - 1;
  899.        ELSE
  900.           DEC( start );
  901.        END;
  902.        WHILE  ( VAL( INTEGER, start ) >= 0 ) & inClass( string[ start ] )  DO
  903.           DEC( start );
  904.        END;
  905.        IF  VAL( INTEGER, start ) >= 0  THEN
  906.           IF   links  THEN
  907.              RETURN( start + 1 );
  908.           ELSE
  909.              RETURN( StringLaenge - start );
  910.           END;
  911.        ELSE
  912.           RETURN( 0 );
  913.        END;
  914.      END  RightPosNotInClass;
  915.  
  916. (* ------------------------------------------------------------------------- *)
  917.  
  918.   PROCEDURE  TrimLeft ((* EIN/AUS *) VAR string : ARRAY OF CHAR );
  919. (*T*)
  920.      VAR  ZielIndex,
  921.           QuellIndex : CARDINAL;
  922.  
  923.      BEGIN
  924.        QuellIndex := 0; ZielIndex := 0;
  925.  
  926.        (* erstes Zeichen finden, dass nicht Blank ist *)
  927.        WHILE  ( QuellIndex <= VAL( CARDINAL, HIGH( string )))  &
  928.               ( string[ QuellIndex ] = ' '                  )
  929.        DO
  930.          INC( QuellIndex );
  931.        END;
  932.  
  933. (*  ( 0 <= i < QuellIndex            ==>  string[ i ]          = ' ' )  &   *)
  934. (*  ( QuellIndex < Length( string )  ==>  string[ QuellIndex ] # ' ' )  &   *)
  935. (*  ( QuellIndex <= Length( string )                                        *)
  936.  
  937.        IF   QuellIndex > 0  THEN   (* nur umkopieren, wenn Blanks am Anfang *)
  938.           WHILE  ( QuellIndex <= VAL( CARDINAL, HIGH( string )))  &
  939.                  ( string[ QuellIndex ] # EOS                  )
  940.           DO
  941.              string[ ZielIndex ] := string[ QuellIndex ];
  942.              INC( ZielIndex ); INC( QuellIndex );
  943.           END;
  944.           (* Da mindestens um ein Zeichen nach links kopiert wird,  *)
  945.           (* ist auf jeden Fall Platz fuer das Nullbyte             *)
  946.  
  947.           string[ ZielIndex ] := EOS;
  948.        END;
  949.      END  TrimLeft;
  950.  
  951. (* ------------------------------------------------------------------------- *)
  952.  
  953.   PROCEDURE  TrimRight ((* EIN/AUS *) VAR string : ARRAY OF CHAR );
  954. (*T*)
  955. (*   VAR  Index : INTEGER; *)
  956.  
  957.      BEGIN
  958. (*     Index := Length( string );
  959.  
  960.        (* letztes Zeichen finden, dass kein Blank ist *)
  961.        REPEAT
  962.          DEC( Index );
  963.          (* (-1<=Index<Length(string)                  )  &
  964.           * ((Index<i<Length(string) => (string[i]#' '))
  965.           *)
  966.        UNTIL  ( Index < 0 )  OR  ( string[ Index ] # ' ' );
  967.  
  968.        (* ((Index<0) OR (string[Index]#' ')          ) &
  969.         * ((Index<i<Length(string) => (string[i]#' '))
  970.         *)
  971.  
  972.        IF   Index < HIGH( string )  THEN
  973.           string[ Index + 1 ] := EOS;
  974.        END;
  975.  
  976.    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  977.  
  978.        string  EQU  12
  979.        HIGH    EQU  string + 4
  980.  
  981.        TrimRight:
  982.          movea.l string(a6), a0  ;
  983.          move.w  HIGH(a6), d0    ;
  984.          move.w  d0, d2          ;
  985.        lenlp:
  986.          tst.b   (a0)+           ;
  987.          dbeq    d0, lenlp       ;
  988.          bne.s   clclen          ; B: String durch Feldende abgeschlossen:
  989.                                  ; steht schon hinter letztem Stringzeichen
  990.          subq.l  #1, a0          ; a0 -> eins hinter letztem Stringzeichen,
  991.                                  ;    statt hinter dem Nullbyte
  992.        clclen:
  993.          sub.w   d0, d2          ; d2 := Length(string)
  994.          moveq   #' ', d1        ; fuer schnellen Vergleich
  995.          moveq   #0, d7          ; damit die Schleife nicht wegen NE abbricht
  996.          bra.s   blklp + 2
  997.        blklp:
  998.          cmp.b   -(a0), d1
  999.          dbne    d2, blklp       ; B: Bisher nur Blanks, String nicht zuende
  1000.          beq.s   clcidx          ; B: <string> nur Blanks, a0 -> erstes Zeichen
  1001.          addq.l  #1, a0          ; a0 -> erstes Blank hinter letztem Buchst.
  1002.        clcidx:
  1003.          move.l  a0, d1
  1004.          movea.l string(a6), a1
  1005.          sub.l   a1, d1          ; d1 := Index dieses Blanks
  1006.          cmp.w   HIGH(a6), d1    ;
  1007.          bhi.s   ende            ; B: <string> fuellt Feld aus und hat keine
  1008.                                  ;   abschliessenden Blanks
  1009.          clr.b   (a0)
  1010.        ende:
  1011. *)
  1012.        INLINE( 206EH,000CH,302EH,0010H,3400H,4A18H,57C8H,0FFFCH,6602H );
  1013.        INLINE( 5388H,9440H,7220H,7E00H,6002H,0B220H,56CAH,0FFFCH,6702H );
  1014.        INLINE( 5288H,2208H,226EH,000CH,9289H,0B26EH,0010H,6202H,4210H );
  1015.  
  1016.      END  TrimRight;
  1017.  
  1018. (* ------------------------------------------------------------------------- *)
  1019.  
  1020.   PROCEDURE  TrimStr ((* EIN/AUS *) VAR string : ARRAY OF CHAR );
  1021. (*T*)
  1022.    BEGIN
  1023.     TrimLeft( string );
  1024.     TrimRight( string );
  1025.    END  TrimStr;
  1026.  
  1027.  
  1028.  
  1029. END  XStrings.
  1030.